home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / XREF.M < prev    next >
Encoding:
Text File  |  1990-05-04  |  5.7 KB  |  172 lines
  1. (*---------------------------------------------------------------------*)
  2. (*---                     Module Cross Reference Generator          ---*)
  3. (*---                    ---------------------------------          ---*)
  4. (*---                                                               ---*)
  5. (*---   XREF aus 4th Edition WIRTH Seite 88                         ---*)
  6. (*---                                                               ---*)
  7. (*--- Programmiersprache :  SPC-Modula-2 V1.4                       ---*)
  8. (*--- Computersystem     :  ATARI 1040 ST                           ---*)
  9. (*--- Autor              :  Uwe A. Ruttkamp                         ---*)
  10. (*--- Datum              :  31.01.1989                              ---*)
  11. (*---                                                               ---*)
  12. (*---------------------------------------------------------------------*)
  13.  
  14. MODULE XREF;
  15.             
  16. FROM ASCII        IMPORT EOL;
  17. FROM InOut        IMPORT Done, RedirectInput, RedirectOutput,
  18.                          Read, Write, WriteInt, WriteString, WriteLn,
  19.                          CloseInput, CloseOutput;
  20. FROM TableHandler IMPORT WordLength, Table, overflow, InitTable,
  21.                          Record, Tabulate, FinishTable;
  22. IMPORT Environment, HFS, CmdLine, Strings;
  23.                          
  24. TYPE
  25.  Alfa = ARRAY [0..9] OF CHAR;
  26. CONST
  27.  N = 45; (* No. of keywords *)
  28. VAR
  29.  ch                 : CHAR;
  30.  i,k,l,m,r,lno      : INTEGER;
  31.  T                  : Table;
  32.  id                 : ARRAY [0..WordLength-1] OF CHAR;
  33.  key                : ARRAY [1..N] OF Alfa;
  34.  Source, Destination,
  35.  Vol, Dir, Doc, Typ : ARRAY [1..100] OF CHAR;
  36.  Ok, View, List     : BOOLEAN;
  37.  
  38.  PROCEDURE Copy;
  39.  BEGIN
  40.   IF List THEN Write(ch); END;
  41.   Read(ch);
  42.  END Copy;
  43.  
  44.  PROCEDURE heading;
  45.  BEGIN
  46.   lno := lno + 1;
  47.   IF List THEN  WriteInt(lno, 5); Write(" ");  END;
  48.  END heading;
  49.  
  50. BEGIN
  51.  InitTable(T);
  52.  key[1]  := "AND ";      key[2]  := "ARRAY ";      key[3]  := "BEGIN ";
  53.  key[4]  := "BITSET ";   key[5]  := "BOOLEAN ";    key[6]  := "BY ";
  54.  key[7]  := "CASE ";     key[8]  := "CARDINAL ";   key[9]  := "CHAR ";
  55.  key[10] := "CONST ";    key[11] := "DIV ";        key[12] := "DO ";
  56.  key[13] := "ELSE ";     key[14] := "ELSIF ";      key[15] := "END ";
  57.  key[16] := "EXIT ";     key[17] := "EXPORT ";     key[18] := "FALSE ";
  58.  key[19] := "FOR ";      key[20] := "FROM ";       key[21] := "IF ";
  59.  key[22] := "IMPORT ";   key[23] := "IN ";         key[24] := "INTEGER ";
  60.  key[25] := "LOOP ";     key[26] := "MOD ";        key[27] := "MODULE ";
  61.  key[28] := "NOT ";      key[29] := "OF ";         key[30] := "OR ";
  62.  key[31] := "POINTER ";  key[32] := "PROCEDURE ";  key[33] := "QUALIFIED ";
  63.  key[34] := "RECORD ";   key[35] := "REPEAT ";     key[36] := "RETURN ";
  64.  key[37] := "SET ";      key[38] := "THEN ";       key[39] := "TO ";
  65.  key[40] := "TRUE ";     key[41] := "TYPE ";       key[42] := "UNTIL ";
  66.  key[43] := "VAR ";      key[44] := "WHILE ";      key[45] := "WITH ";
  67.  
  68.  WriteString('cross reference generator'); WriteLn;
  69.  
  70.  Ok := TRUE;
  71.  IF NOT CmdLine.FileArg(Source) THEN
  72.   IF NOT Environment.Get('WorkFile', Source) THEN
  73.    Source := '\TEST.MOD';
  74.   END;
  75.   HFS.Decode(Source, Vol, Dir, Doc, Typ);
  76.   HFS.Encode(Vol, Dir, Doc, '.MOD', Source);
  77.   HFS.AskName(Source, Ok);
  78.  END;
  79.  
  80.  IF Ok AND NOT CmdLine.FileArg(Destination) THEN
  81.   HFS.Decode(Source, Vol, Dir, Doc, Typ);
  82.   HFS.Encode(Vol, Dir, Doc, '.REF', Destination);
  83.   HFS.AskName(Destination, Ok);
  84.  END;
  85.  
  86.  View := FALSE; List := FALSE;
  87.  IF Ok THEN
  88.   WHILE CmdLine.Option(ch, Doc) DO
  89.    IF    CAP(ch) = 'V' THEN View := TRUE;
  90.    ELSIF CAP(ch) = 'L' THEN List := TRUE;
  91.    END;
  92.   END;
  93.  END;
  94.  
  95.  IF Ok THEN
  96.   IF View THEN WriteString(' * '); WriteString(Source); END;
  97.   RedirectInput(Source);
  98.   Ok := Ok AND Done;
  99.   IF View THEN WriteString(' opened'); WriteLn; END;
  100.  END;
  101.  
  102.  IF Ok THEN
  103.   IF View THEN WriteString(' + '); WriteString(Destination); END;
  104.   RedirectOutput(Destination);
  105.   IF NOT Done THEN CloseInput; END;
  106.   Ok := Ok AND Done;
  107.  END;
  108.    
  109.  IF Ok THEN
  110.   lno := 0;
  111.   Read(ch);
  112.   IF Done THEN heading;
  113.    REPEAT
  114.     IF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN
  115.      k:=0;
  116.      REPEAT id[k] := ch; k:=k+1; Copy
  117.      UNTIL (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z");
  118.      l := 1; r := N; id[k] := " ";
  119.      REPEAT m := (l+r) DIV 2; i:=0;  (* binary search *)
  120.       WHILE (id[i] = key[m,i]) & (id[i] > " ") DO i := i + 1; END;
  121.       IF id[i] <= key[m,i] THEN r := m - 1 END;
  122.       IF id[i] >= key[m,i] THEN l := m + 1 END;
  123.      UNTIL l>r;
  124.      IF l=r+1 THEN Record(T, id, lno) END
  125.     ELSIF (ch >= "0") & (ch <= "9") THEN
  126.      REPEAT Copy
  127.      UNTIL ((ch < "0") OR (ch > "9")) & ((ch < "A") OR (ch > "Z"))
  128.     ELSIF ch = "(" THEN
  129.      Copy;
  130.       IF ch = "*" THEN  (* comment *)
  131.       REPEAT
  132.        REPEAT
  133.         IF ch = EOL THEN
  134.          Copy; heading
  135.         ELSE Copy
  136.         END
  137.        UNTIL ch = "*";
  138.        Copy;
  139.       UNTIL ch = ")";
  140.       Copy;
  141.      END
  142.     ELSIF ch = "'" THEN
  143.      REPEAT Copy UNTIL ch = "'";
  144.      Copy;
  145.     ELSIF ch = '"' THEN
  146.      REPEAT Copy UNTIL ch = '"';
  147.      Copy;
  148.     ELSIF ch = EOL THEN
  149.      Copy;
  150.      IF Done THEN heading END;
  151.     ELSE Copy
  152.     END
  153.    UNTIL NOT Done OR (overflow # 0)
  154.   END;
  155.   IF overflow > 0 THEN
  156.    WriteString("Table overflow"); WriteInt(overflow,6);
  157.    Write(EOL);
  158.   END;
  159.   WriteLn;
  160.   WriteString('Cross-reference list of ');
  161.   WriteString(Destination); WriteLn;
  162.   Tabulate(T); CloseInput; CloseOutput;
  163.   IF View THEN WriteString(' written'); END;
  164.   Strings.Concat('done ',Destination, Destination);
  165.   CmdLine.ResultIs(TRUE, Destination);
  166.  ELSE
  167.   CmdLine.ResultIs(FALSE, 'not done');
  168.  END;
  169.  FinishTable(T);
  170.  IF View THEN WriteLn; END;
  171. END XREF.
  172.